home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbwinfnt.zip / QBWINFNT.BAS < prev    next >
BASIC Source File  |  1994-03-01  |  34KB  |  926 lines
  1.       REM:  QBWINFNT.BAS, Unregistered Version 1.0
  2.       REM:  Routines to use windows fonts in DOS QBasic/QuickBasic.
  3.  
  4.       DECLARE FUNCTION WidthString% (Text$, FontArray%())
  5.      
  6.       DECLARE SUB BLOADFont (FlName$, FontArray%(), RetCode%)
  7.       DECLARE SUB BSAVEFont (FlName$, FontArray%())
  8.       DECLARE SUB DispChar (Char%, FClr%, BClr%, X%, Y%, FontArray%())
  9.       DECLARE SUB DispString (Text$, FClr%, BClr%, X%, Y%, FontArray%())
  10.       DECLARE SUB FastChar (Char%, FClr%, X%, Y%, FontArray%())
  11.       DECLARE SUB FastString (Text$, FClr%, X%, Y%, FontArray%())
  12.       DECLARE SUB LoadFontFile (FlName$, FontArray%(), RetCode%, RetMsg$)
  13.       DECLARE SUB LoadRsrcFileFont (FlName$, FontNum%, FontArray%(), RetCode%, RetMsg$)
  14.  
  15.       CONST NumHdrElem = 11            '...number of elements in font header
  16.     
  17.       TYPE FontType
  18.         Version        AS INTEGER      '...version
  19.         Size           AS LONG         '...size of font in bytes
  20.         Copyright      AS STRING * 60  '...copyright string
  21.         FType          AS INTEGER      '...font type
  22.         Pnt            AS INTEGER      '...point size for optimum display
  23.         VertRes        AS INTEGER      '...vertical resolution in pixels per inch
  24.         HorizRes       AS INTEGER      '...horizontal resolution in pixels per inch
  25.         Ascent         AS INTEGER      '...distance from top of char cell to baseline
  26.         IntLeading     AS INTEGER      '...distance above tops of char's to top of cell
  27.         ExtLeading     AS INTEGER      '...recommended distance above top of cell
  28.         Italic         AS STRING * 1   '...italic font if equal to 1
  29.         Underline      AS STRING * 1   '...underlined font if equal to 1
  30.         StrikeOut      AS STRING * 1   '...strike-out font if equal to 1
  31.         Weight         AS INTEGER      '...relative weight
  32.         CharSet        AS STRING * 1   '...character set
  33.         PixWidth       AS INTEGER      '...width of character grid in pixels
  34.         PixHeight      AS INTEGER      '...height of character grid in pixels
  35.         PitchandFamily AS STRING * 1   '...description of pitch and family
  36.         AvgWidth       AS INTEGER      '...average width
  37.         MaxWidth       AS INTEGER      '...width of widest character
  38.         FirstChar      AS STRING * 1   '...ASCII value of first char
  39.         LastChar       AS STRING * 1   '...ASCII value of last char
  40.         DefaultChar    AS STRING * 1   '...relative char value for out of range chars
  41.         BreakChar      AS STRING * 1   '...relative char value for word seperator char
  42.         WidthBytes     AS INTEGER      '...number of bytes in each row
  43.         Device         AS LONG         '...offset in bytes to font's device name string
  44.         Face           AS LONG         '...offset in bytes to face name
  45.         BitsPointer    AS LONG         '...unused and set to zero
  46.         BitsOffset     AS LONG         '...offset in bytes to start of bitmap or stroke data
  47.         Reserved1      AS STRING * 1   '...reserved
  48.       END TYPE
  49.  
  50.       TYPE ExeHdrType
  51.         Signature      AS STRING * 2   '...MZ for valid EXE code file
  52.         ExtraBytes     AS INTEGER      '...number bytes in last page
  53.         Pages          AS INTEGER      '...number whole & partial pages (512 bytes)
  54.         RelocItems     AS INTEGER      '...number relocation table pointers
  55.         HeaderSize     AS INTEGER      '...number 16 byte paragraphs in header
  56.         UnusedHere     AS STRING * 50  '...values not needed by this program
  57.         WinInfoOffset  AS INTEGER      '...offset in bytes to WinInfo structure
  58.       END TYPE
  59.     
  60.       TYPE WinInfoType
  61.         Signature      AS STRING * 2   '...NE if valid
  62.         UnusedHere1    AS STRING * 34  '...values not needed by this program
  63.         ResTabOffset   AS INTEGER      '...offset to resource table (in bytes relative to WinInfo)
  64.         UnusedHere2    AS STRING * 26  '...values not needed by this program
  65.       END TYPE
  66.  
  67.       TYPE ResInfoType
  68.         TypeID         AS INTEGER      '...resource type
  69.         ResCount       AS INTEGER      '...number of resources of this type
  70.         Reserved       AS LONG         '...unused
  71.       END TYPE
  72.  
  73.       TYPE NameInfoType
  74.         Offset         AS INTEGER      '...offset in alignment units
  75.         Length         AS INTEGER      '...length in bytes of resource
  76.         Flags          AS INTEGER      '...resource flags
  77.         ID             AS INTEGER      '...identifier
  78.         Reserved1      AS INTEGER      '...unused or reserved
  79.         Reserved2      AS INTEGER      '...unused or reserved
  80.       END TYPE
  81.     
  82.       TYPE GlyphType
  83.         PWidth         AS INTEGER      '...character width in pixels
  84.         Offset         AS INTEGER      '...offset to character bitmap
  85.       END TYPE
  86.  
  87.  
  88. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  89. ' FONT Structure:
  90. '     Font Height  --  0  --  2 bytes  -- Char height in pixels
  91. '     Number Chars --  1  --  2 bytes  -- Total number of characters
  92. '     First Char   --  2  --  2 bytes  -- First character in set
  93. '     Last Char    --  3  --  2 bytes  -- Last character in set
  94. '     Default Char --  4  --  2 bytes  -- Default character
  95. '     Break Char   --  5  --  2 bytes  -- Break character
  96. '     Max Width    --  6  --  2 bytes  -- Max char width
  97. '     Vert Spacing --  7  --  2 bytes  -- Vertical spacing
  98. '     Ascent       --  8  --  2 bytes  -- Distance from char top to baseline
  99. '     Pad Width    --  9  --  2 bytes  -- Extra pixels to add between chars
  100. '     Pad Height   -- 10  --  2 bytes  -- Extra pixels to add between lines
  101. '     Char Width   --  2 bytes/char    -- Char width in pixels
  102. '     Char Offset  --  2 bytes/char    -- Char offset into bitmap
  103. '
  104. ' Notes: (1) The total number of characters N = LastChar - FirstChar + 1
  105. '        (2) Char width consists of 2 bytes per character.  The width of
  106. '            a given character c% is given by: FontArray%(10+c%)
  107. '        (3) Char offset consists of 2 bytes per character.  The offset of
  108. '            a given character c% is given by: FontArray%(10+N+c%)
  109. '
  110. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  111.  
  112. '     ************************************************************************
  113.       SUB BLOADFont (FlName$, FontArray%(), RetCode%)
  114. '     ************************************************************************
  115.      
  116.       '...be nice - use the next available file number...
  117.       FileNum% = FREEFILE
  118.      
  119.       '...open file for binary, get size, and close...
  120.       OPEN FlName$ FOR BINARY AS FileNum%
  121.         SizeInBytes& = LOF(FileNum%)
  122.       CLOSE FileNum%
  123.      
  124.       '...size is zero if the file doesn't exist...
  125.       IF (SizeInBytes& = 0) THEN RetCode% = -1: RETURN
  126.  
  127.       '...subtract 7 bytes of the BSAVE/BLOAD header...
  128.       SizeInBytes& = SizeInBytes& - 7
  129.  
  130.       '...redimension the font array (2 bytes per integer element)...
  131.       REDIM FontArray%((SizeInBytes& - 1) \ 2)
  132.      
  133.       '...set to segment of the font array...
  134.       DEF SEG = VARSEG(FontArray%(0))
  135.  
  136.       '...save the array to a file...
  137.       BLOAD FlName$, VARPTR(FontArray%(0))
  138.  
  139.       '...restore default segment...
  140.       DEF SEG
  141.  
  142.       '...clear the return code for everything OK...
  143.       RetCode% = 0
  144.  
  145.       END SUB
  146.  
  147. '     ************************************************************************
  148.       SUB BSAVEFont (FlName$, FontArray%())
  149. '     ************************************************************************
  150.      
  151.       '...compute the number of bytes to save...
  152.       NumBytes& = 2& * (UBOUND(FontArray%) - LBOUND(FontArray%) + 1)
  153.  
  154.       '...set to segment of the font array...
  155.       DEF SEG = VARSEG(FontArray%(0))
  156.  
  157.       '...save the array to a file...
  158.       BSAVE FlName$, VARPTR(FontArray%(0)), NumBytes&
  159.  
  160.       '...restore default segment...
  161.       DEF SEG
  162.      
  163.       END SUB
  164.  
  165. '     ************************************************************************
  166.       SUB DispChar (Char%, FClr%, BClr%, X%, Y%, FontArray%())
  167. '     ****************************************************